home *** CD-ROM | disk | FTP | other *** search
/ Micom Basic 1995 October / CD [BM9510].bin / basic / toukou / n88basic / amidar.bas < prev    next >
Encoding:
BASIC Source File  |  1995-08-11  |  6.3 KB  |  102 lines
  1. 1000 '          save "amidar.bas"
  2. 1010 '                      -----< Amidar Man >-----
  3. 1020 '                         Programed by T.Iro
  4. 1030 CLEAR: SCREEN 3,0,0,1: CONSOLE 0,25,0,1: COLOR 7,,,,2: CLS 3
  5. 1040 DEFINT A-Z: DIM GR(257,13),MP(19,10),DF(6,1),DR(10,4),LD(3,3)
  6. 1050 GOSUB *GLOD: GOSUB *TITL
  7. 1060 FOR I=0 TO  6: READ CN(I): NEXT
  8. 1070 FOR I=0 TO  3: FOR J=0 TO 3: READ LD(I,J): NEXT J,I
  9. 1080 FOR I=0 TO 10: FOR J=1 TO 4: READ DR(I,J): NEXT J,I
  10. 1090 FOR I=0 TO  7: READ MS$(I): NEXT
  11. 1100 PL=5: ST=0: SC=0: HS=1000: WA=200: L(0)=&HAAAA: L(1)=&H5555
  12. 1110 *MAIN ' --------------------------------------------------------- [ main ]
  13. 1120 ST=ST+1: TI=500: GOSUB *SMAK: GOSUB *PRIN: GF=0
  14. 1130 WHILE GF=0: TI=TI+(PL>0)*2: GOSUB *PRIN
  15. 1140   FOR I=0 TO 6: X=X(I): Y=Y(I): M1=MP(X,Y)
  16. 1150     IF CH(I)=0 THEN FOR W=0 TO WA: NEXT: GOTO 1210
  17. 1160     ON I+1 GOSUB *KYIN: GOSUB *ERAC: IF I>1 THEN GOSUB *HCHE
  18. 1170     GOSUB *DRCT: F=1: IF Y+VY<0 OR Y+VY>9 THEN F=-1: GOTO 1190
  19. 1180     IF DR(MP(X+VX,Y+VY),D)>0 THEN DF(I,1)=D: GOTO 1200
  20. 1190     DF(I,1)=DR(10,D): DF(I,0)=DF(I,0)*F: GOTO 1170
  21. 1200     X(I)=X+VX: Y(I)=Y+VY: GOSUB *PUTC: IF I>1 THEN GOSUB *HCHE
  22. 1210     IF PL=0 THEN COLOR 2: LOCATE 30,12: PRINT AKCNV$("Game Over")
  23. 1220   NEXT: IF X(1)=0 AND Y(1)=9 AND PL>0 THEN GF=1
  24. 1230   IF PL=0 AND INP(233)=191 THEN GF=2 ELSE IF TI=0 AND PL>0 THEN GF=3
  25. 1240 WEND: COLOR 1: LOCATE 26,12: PRINT AKCNV$(MS$(GF-1))
  26. 1250 COLOR 7: GOSUB *WAIS: CLS: ON GF GOTO *CLEA,*GMOV,*TMOV
  27. 1260 *DRCT ' ---------------------------------------------------- < direction >
  28. 1270 VX=0: VY=0: D=DR(M1,DF(I,1)): IF D=5 THEN D=DF(I,0)+2
  29. 1280 IF D MOD 2=1 THEN VY=D-2: RETURN ELSE VX=D-3: RETURN
  30. 1290 *KYIN ' ---------------------------------------------------- < key input >
  31. 1300 K1=INP(224): K2=INP(225): VX=0: VY=0
  32. 1310 IF (K1 OR 239)=239 THEN VX=-1 ELSE IF (K1 OR 191)=191 THEN VX=1
  33. 1320 IF (K2 OR 254)=254 THEN VY=-1 ELSE IF (K1 OR 251)=251 THEN VY=1
  34. 1330 IF VY<>0 THEN DF(0,0)=VY      ELSE IF (K1 OR 223)=223 THEN RETURN
  35. 1340 IF ABS(VX+VY)=1 THEN *MCHE ELSE VX=0: VY=0: RETURN 1200
  36. 1350 *MCHE ' --------------------------------------------------- < move check >
  37. 1360 IF X+VX<0 OR X+VX>19 OR Y+VY<0 OR Y+VY>9 THEN VX=0: VY=0: RETURN 1200
  38. 1370 D=VX+3 AND -ABS(VX) OR VY+2 AND -ABS(VY): M2=MP(X+VX,Y+VY)
  39. 1380 IF M1=1 AND M2=0       THEN                       M1=4-D/2: GOTO 1420
  40. 1390 IF M1=0 AND DR(M2,D)>0 THEN M1=LD(DF(0,1)-1,D-1):           GOTO 1420
  41. 1400 IF M1=0 AND M2=1       THEN M1=LD(DF(0,1)-1,D-1): M2=1+D/2: GOTO 1420
  42. 1410 IF DR(M1,DR(10,D))=0 OR DR(M2,D)=0 THEN VX=0: VY=0:   RETURN 1200
  43. 1420 MP(X,Y)=M1: MP(X+VX,Y+VY)=M2: DF(0,1)=D: GOSUB *ERAC: RETURN 1200
  44. 1430 *HCHE ' ---------------------------------------------------- < hit check >
  45. 1440 IF X(I)=X(1) AND Y(I)=Y(1) AND PL>0 THEN 1480
  46. 1450 IF X(I)<>X(0) OR Y(I)<>Y(0) OR X(I)=0 AND Y(I)=0 THEN RETURN
  47. 1460 GOSUB *BEP1: PL=PL-1: X(0)=0: Y(0)=0: DF(0,0)=1: DF(0,1)=3: GOSUB *PRIN
  48. 1470 IF PL=0 THEN CH(0)=0: RETURN ELSE RETURN
  49. 1480 GOSUB *BEP2: CH(I)=0: SC=SC+100: GOSUB *PRIN: GOSUB *ERAC: RETURN 1220
  50. 1490 *CLEA ' -------------------------------------------------- < stage clear >
  51. 1500 TI=((TI+9)\10)*10
  52. 1510 FOR I=1 TO TI\10: SC=SC+10: TI=TI-10: GOSUB *BEP2: GOSUB *PRIN: NEXT
  53. 1520 IF ST<5 THEN PL=PL+1: GOSUB *WAIS: GOTO *MAIN
  54. 1530 FOR I=0 TO 15: LINE(184,192+I)-(439,192+I),0,,L(I MOD 2): NEXT
  55. 1540 MN=SC\320-3: IF MN<3 THEN MN=3 ELSE IF MN>7 THEN MN=7
  56. 1550 COLOR 5: LOCATE 24,12: PRINT AKCNV$(MS$(MN)): GOSUB *WAIS
  57. 1560 *GMOV ' ---------------------------------------------------- < game over >
  58. 1570 WHILE INP(233)<>255: WEND: IF HS<SC THEN HS=SC
  59. 1580 GOSUB *TITL: PL=5: ST=0: SC=0: GOTO *MAIN
  60. 1590 *TMOV ' ---------------------------------------------------- < time over >
  61. 1600 PL=PL-1: GOSUB *PRIN: IF PL>0 THEN ST=ST-1: GOTO *MAIN
  62. 1610 GF=0: I=0: GOSUB *ERAC: CH(0)=0: GOTO 1130
  63. 1620 *PUTC ' ------------------------------------------------ < put character >
  64. 1630 PUT(X(I)*32,Y(I)*32+48),GR(0,CN(I))          ,PSET: RETURN
  65. 1640 *ERAC ' ---------------------------------------------- < erase character >
  66. 1650 PUT(X(I)*32,Y(I)*32+48),GR(0,MP(X(I),Y(I))+4),PSET: RETURN
  67. 1660 *PRIN ' -------------------------------------------------------- < print >
  68. 1670 LOCATE  0,0: PRINT AKCNV$("Amidar Man : "+RIGHT$(STR$(PL),1))
  69. 1680 LOCATE 10,1: PRINT AKCNV$("Stage :"+STR$(ST))
  70. 1690 LOCATE 38,0: PRINT AKCNV$(RIGHT$(STR$((TI+9)\10),2))
  71. 1700 LOCATE 50,0: PRINT AKCNV$("Hi-Score : "+RIGHT$("  "+STR$(HS),4))
  72. 1710 LOCATE 56,1: PRINT AKCNV$("Score : "+RIGHT$("  "+STR$(SC),4)): RETURN
  73. 1720 *WAIS ' ------------------------------------------- < wait for space key >
  74. 1730 WHILE (INP(233) OR 191)<>191: WEND: RETURN
  75. 1740 *BEP1 ' ------------------------------------------------- < beep sound 1 >
  76. 1750 FOR B=0 TO 20: BEEP 1: FOR C=0 TO 20: BEEP 0: NEXT C,B: RETURN
  77. 1760 *BEP2 ' ------------------------------------------------- < beep sound 2 >
  78. 1770 FOR B=1 TO 20: BEEP 1: FOR C=B TO LOG(B): BEEP 0: NEXT C,B: BEEP 0: RETURN
  79. 1780 *SMAK ' ------------------------------------------------- < stage making >
  80. 1790 ERASE MP: DIM MP(19,9)
  81. 1800 FOR I=1 TO 11: FOR J=0 TO 19: PUT(J*32,I*32+16),GR(0,4),PSET: NEXT J,I
  82. 1810 FOR I=0 TO  4: L=I*5+(I=4): FOR J=0 TO 9
  83. 1820   MP(L,J)=1: PUT(L*32,(J+1)*32+16),GR(0,5),PSET
  84. 1830 NEXT J,I
  85. 1840 FOR I=0 TO 6: CH(I)=0: DF(I,0)=1: DF(I,1)=3: NEXT: PK=ST
  86. 1850 FOR I=0 TO 1: CH(I)=1: X(I)=19*I: Y(I)=0: NEXT
  87. 1860 FOR I=2 TO PK+1: X(I)=(I\2)*5:    Y(I)=(I MOD 2)*9: CH(I)=1: NEXT
  88. 1870 FOR I=0 TO 6: ON CH(I) GOSUB *PUTC: NEXT
  89. 1880 PUT(0,368),GR(0,3),PSET: RETURN
  90. 1890 *GLOD ' ------------------------------------------- < graphics data load >
  91. 1900 DEF SEG=VARPTR(GR(0,0),1): BLOAD "amidar.chr",0: RETURN
  92. 1910 *TITL ' ------------------------------------------------- < title screen >
  93. 1920 CLS 3:   WIDTH  40,20: COLOR 5: LOCATE 15, 8: PRINT "Amidar Man"
  94. 1930 COLOR 6: LOCATE 12,11: PRINT "Hit space key !!": GOSUB *WAIS
  95. 1940 COLOR 7: WIDTH  80,25: RETURN
  96. 1950 ' *************************************************************** < data >
  97. 1960 DATA 0,2,1,1,1,1,1     , 4,8,0,7 , 6,5,7,0 , 0,9,4,6 , 9,0,8,5
  98. 1970 DATA 3,4,1,2 , 1,0,3,0 , 4,5,4,0 , 2,0,2,5 , 1,0,3,0
  99. 1980 DATA 0,2,0,4 , 0,1,4,0 , 4,3,0,0 , 2,0,0,3 , 0,0,2,1 , 3,4,1,2
  100. 1990 DATA "Stage clear !",,"--Time over--","Congratulations","  Wonderful !"
  101. 2000 DATA "  Fantastic !", "  Marvelous !","Unbelievable !!"
  102.